Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/ibmlogo.zip/VGALOGO.PAS

Pascal/Delphi Source File | 1993-01-04 | 35KB | 1,090 lines

PROGRAM VGA_IBM_LOGO;
{$R-}                         { -> program is much faster }
{$L setpal }              { link the set palette routines }

{*********************************************************}
{*                                                       *}
{* VGA/MCGA-Demo/Test-program           Version 1.21     *}
{*                                                       *}
{* IBM INTERNAL USE ONLY                                 *}
{*                                                       *}
{* Copyright (c) IBM Corporation 1988                    *}
{* November 1988                                         *}
{*                                                       *}
{* Idea: David A Kerr wrote the program for the          *}
{*       8514/A display in C                             *}
{*                                                       *}
{* Adapted to VGA / MCGA and to Turbo Pascal 4.0:        *}
{*       Christian Michel                                *}
{*       IBM Deutschland GmbH                            *}
{*       BI Berufsausbildung Sindelfingen 1              *}
{*       Adrs : 7032-54    Kst. 5318                     *}
{*       VM-ID : CMICHEL at STUTVM3                      *}
{*                                                       *}
{* IBM logo is a registered trademark. Modification      *}
{* of logo not permitted.                                *}
{* Replacement with other logo allowed.                  *}
{*                                                       *}
{*********************************************************}


USES DOS,CRT;


TYPE rgb          = RECORD
                      red,green,blue : BYTE;
                    END;
     vga_table    = ARRAY [0..255] of rgb;
     ega_map_type = ARRAY [0..16] of BYTE;


VAR palette,old_pal : vga_table;
    ega_map         : ega_map_type;
    draw_color      : BYTE;
    logo_ofs,i,j,
    hour,min,sec,
    hundred,
    old_mode        : WORD;
    wait,little,
    error           : INTEGER;
    key             : CHAR;
    starttime,
    endtime         : LONGINT;
    cmdline         : STRING;
    directstart,
    check_time,
    frozen,
    slowdown        : BOOLEAN;

{ Explanation of important variables                       }
{   palette    : color palette for 256 colors              }
{   old_pal    : current palette when starting VGALOGO     }
{   ega_map    : current EGA mapping when starting VGALOGO }
{   draw_color : color to draw the big logo                }
{   logo_ofs   : x,y offset to draw big logo (used for 3-D)}
{   hour,min,                                              }
{   sec,hundred: time got with GETTIME                     }
{   old_mode   : video mode when starting VGALOGO          }
{   wait       : delay of color sweep                      }
{   little     : way the little logos are scrolled through }
{   starttime  : time in seconds                           }
{   endtime    : time in seconds                           }
{   cmdline    : string with single parameter              }
{   check_time : end time is only checked when TRUE        }
{   frozen     : indicates that the palette was frozen     }
{                at the beginning of the program           }
{   slowdown   : indicates slow machines (palette change)  }



PROCEDURE check_vga;

{ Check the presence of the VGA/MCGA - graphics adapter    }

  VAR reg : REGISTERS;

  BEGIN { check_vga }
    reg.AX := $1a00;  { read display combination code }
    INTR ($10,reg);

{ on exit:                                                 }
{    AL = 1Ah -> function 1Ah supported by BIOS            }
{    BL = 7,8 VGA mono / color                             }
{    BL = 11,12 MCGA mono / color                          }

    IF (reg.AL<>$1a) OR NOT (reg.BL in [7,8,11,12]) THEN
      BEGIN
        WRITELN (#7,'Sorry, the program needs a VGA or MCGA.');
        HALT;
      END;
  END; { check_vga }



PROCEDURE save_old_video_state;

{ get the old palette and the current video mode           }

  VAR reg : REGISTERS;

  BEGIN { save_old_video_state }

{ first get the old video mode                             }
    reg.AH := $0f;
    INTR ($10,reg);
    old_mode := reg.AL;

{ then get the old VGA palette                             }
    WITH reg DO
      BEGIN
        AX := $1017;              { read palette registers }
        BX := 0;                  { starting color         }
        CX := 256;                { how many colors        }
        ES := SEG (old_pal);      { load adress of old_pal }
        DX := OFS (old_pal);      { to ES:DX               }
      END;
    INTR ($10,reg);

{ and now get the old EGA mapping                          }
    WITH reg DO
      BEGIN
        AX := $1009;              { read EGA mapping       }
        ES := SEG (ega_map);      { load adress of ega_map }
        DX := OFS (ega_map);      { to ES:DX               }
      END;
    INTR ($10,reg);

{ check whether the palette is now frozen or not           }
{ check the BIOS-flag at address $0040:$0089 Bit 3         }
{         Bit 3 = 0 -> palette not frozen                  }
{         Bit 3 = 1 -> palette is frozen                   }
{ I found this flag by tracing the BIOS-interrupt. So I    }
{ can't guarantee that this will be the same with other    }
{ BIOS - versions than February 13th, 87.                  }
    frozen := ( MEM [$0040:$0089] AND 8 = 8);

{ Thaw the palette so that it is changed when switching    }
{ video modes. Do this only if palette was frozen.         }
    IF frozen THEN
       BEGIN
         reg.AX := $1200;
         reg.BL := $31;
         INTR ($10,reg);
       END;

{ finally set the text mode 3 (80 chars/line color)        }
    reg.AX := $03;
    INTR ($10,reg);
  END; { save_old_video_state }



PROCEDURE set_mode_13;

{ set the graphics mode 13h                                }

  VAR reg : REGISTERS;

  BEGIN { set_mode_13 }
    reg.AX := $13;
    INTR ($10,reg);
  END; { set_mode_13 }



PROCEDURE restore_old_video_state;

{ load the old palette,EGA mapping and set old video mode  }

  VAR reg : REGISTERS;

  BEGIN { restore_old_video_state }

{ set the old video mode                                   }
    reg.AX := old_mode;
    INTR ($10,reg);

{ set the old VGA palette                                  }
    WITH reg DO
      BEGIN
        AX := $1012;              { set palette registers  }
        BX := 0;                  { starting color         }
        CX := 256;                { how many colors        }
        ES := SEG (old_pal);      { load adress of old_pal }
        DX := OFS (old_pal);      { to ES:DX               }
      END;
    INTR ($10,reg);

{ and now set the old EGA mapping                          }
    WITH reg DO
      BEGIN
        AX := $1002;              { write EGA mapping      }
        ES := SEG (ega_map);      { load adress of ega_map }
        DX := OFS (ega_map);      { to ES:DX               }
      END;
    INTR ($10,reg);

{ Freeze the palette so that it is not changed when        }
{ switching video modes. Do this only if the palette was   }
{ frozen at the beginning of the program.                  }
    IF frozen THEN
       BEGIN
         reg.AX := $1201;
         reg.BL := $31;
         INTR ($10,reg);
       END;

  END; { restore_old_video_state }



PROCEDURE fast_pal (VAR table : vga_table); external;



PROCEDURE slow_pal (VAR table : vga_table); external;



PROCEDURE slow_lower (VAR table : vga_table); external;



PROCEDURE clear_palette;

  VAR count : INTEGER;

  BEGIN { clear_palette }
{ only colors 0 to 106 are used                            }

    FOR count := 0 TO 106 DO
      BEGIN
        palette [count].red   := 0;
        palette [count].blue  := 0;
        palette [count].green := 0;
      END;
    slow_pal (palette);
  END; { clear_palette }



PROCEDURE init_palette;

  VAR count : INTEGER;

  BEGIN { init_palette }
{ information about the use of the color numbers :         }
{     0       : background                                 }
{     1-56    : sweeping colors of big logo                }
{     57-101  : sweeping colors of little logos            }
{     102     : static color of little logos               }
{     103-106 : 3-D effect of big logo                     }

{ colors of big logo and background are all blue           }

    FOR count := 0 TO 56 DO
      BEGIN
        palette [count].red   :=0;
        palette [count].blue  :=24;
        palette [count].green :=0;
      END;

{ colors of little logos are all black                     }

    FOR count := 57 TO 101 DO
      BEGIN
        palette [count].red   :=0;
        palette [count].blue  :=0;
        palette [count].green :=0;
      END;

{ set colors to give the 3-D effect to the big logo        }

    FOR count := 103 TO 106 DO
      BEGIN
        palette [count].red   :=0;
        palette [count].blue  :=24;
        palette [count].green :=0;
      END;
    palette [103].green := 28;
    palette [104].green := 26;
    palette [105].green := 24;
    palette [106].green := 22;

    slow_pal (palette);
  END; { init_palette }



PROCEDURE plot_w_t (x,y : WORD; color : BYTE);

{ Plot a pixel only if it isn't already set                }

  VAR offset : WORD;

  BEGIN { plot_w_t }
     offset := x + 320*y;
     IF MEM [$a000:offset]=0 THEN MEM [$a000:offset] := color;
  END; { plot_w_t }



PROCEDURE draw (x0,y0,x1,y1 : WORD; color : BYTE);

{ Draw a line                                              }

  VAR dx,dy,
      dsum,
      count,help : WORD;
      ix,iy,
      ax,ay   : INTEGER;

  BEGIN { draw }
    ay := 0;      ax := 0;
    IF x1>=x0 THEN
      BEGIN
        dx := x1 - x0;   ix := 1;
      END
     ELSE
      BEGIN
        dx := x0 - x1;   ix := -1;
      END;
    IF y1>=y0 THEN
      BEGIN
        dy := y1 - y0;   iy := 1;
      END
     ELSE
      BEGIN
        dy := y0 - y1;   iy := -1;
      END;
    IF dx < dy THEN
      BEGIN
        help := dx;   dx := dy;    dy := help;
        ay := ix;     ax := iy;    ix := 0;    iy := 0;
      END;
    dsum := dx DIV 2;  count := 1;
    plot_w_t (x0,y0,color);
    WHILE count <= dx DO
      BEGIN
        x0 := x0 + ix;   y0 := y0 + ax;   INC (count);
        dsum := dsum + dy;
        IF dsum > dx THEN
          BEGIN
            dsum := dsum - dx;  x0 := x0 + ay;  y0 := y0 + iy;
          END;
        plot_w_t (x0,y0,color);
      END;
  END; { draw }



PROCEDURE fill (x,y : WORD; color : BYTE);

{ fill any box, y-top line to fill, x-any point within the }
{ box that is to be filled                                 }

 VAR offset : WORD;

 PROCEDURE fill_one_line;

   VAR lmargin,          { left margin of line to fill     }
       rmargin,          { right margin of line to fill    }
       carry    : WORD;  { carry bit when calculating the  }
                         { mid point between lmargin and   }
                         { rmargin                         }

   BEGIN { fill_one_line }
     MEM [$a000:offset] := color; { set the starting pixel }

     lmargin := offset-1;
     WHILE MEM [$a000:lmargin] = 0 DO
       BEGIN { fill to left margin of the box }
       MEM [$a000:lmargin] := color;
       DEC (lmargin);
       END;

     rmargin := offset+1;
     WHILE MEM [$a000:rmargin] = 0 DO
       BEGIN { fill to right margin of the box }
       MEM [$a000:rmargin] := color;
       INC (rmargin);
       END;

     carry := rmargin AND lmargin AND 1;
     offset := lmargin SHR 1 + rmargin SHR 1 + carry;
   END; { fill_one_line }

 BEGIN { fill }
   offset := y*320 +x;
   WHILE MEM [$a000:offset]=0 DO { if color<>0 -> bottom   }
     BEGIN                       { line is reached         }
       fill_one_line;
       INC (offset,320);
     END;
 END;  { fill }



PROCEDURE linex (x1,x2,y : WORD; color : BYTE);

{ draw a horizontal line                                   }

  VAR offset,help : WORD;

  BEGIN { linex }
    IF x1>x2 THEN
      BEGIN
        help := x1;
        x1 := x2;
        x2 := help;
      END;
    offset := x1 + 320*y;
    REPEAT
      IF MEM [$a000:offset]=0 THEN MEM [$a000:offset] := color;
      INC (x1); INC (offset);
    UNTIL x1 > x2;
  END; { linex }



PROCEDURE liney (x,y1,y2 : WORD; color : BYTE);

{ draw a vertical line                                     }

  VAR offset,help : WORD;

  BEGIN { liney }
    IF y1>y2 THEN
      BEGIN
        help := y1;
        y1 := y2;
        y2 := help;
      END;
    offset := x +320*y1;
    REPEAT
      IF MEM [$a000:offset]=0 THEN MEM [$a000:offset] := color;
      INC (y1); INC (offset,320);
    UNTIL y1 > y2;
  END; { liney }



PROCEDURE t_box (x1,y1,x2 : WORD; color : BYTE);

  BEGIN { t_box }
    linex (x1+logo_ofs,x2+logo_ofs,y1+logo_ofs,color);
    liney (x2+logo_ofs,y1+logo_ofs,y1+6+logo_ofs,color);
    linex (x2+logo_ofs,x1+logo_ofs,y1+6+logo_ofs,color);
    liney (x1+logo_ofs,y1+logo_ofs,y1+6+logo_ofs,color);
    fill (x1+logo_ofs+1,y1+logo_ofs+1,color);
  END; { t_box }



PROCEDURE t_box2 (x1,y1,x2,x3,x4 : WORD; color : BYTE);

  BEGIN { t_box2 }
    linex (x1+logo_ofs,x2+logo_ofs,y1+logo_ofs,color);
    draw (x2+logo_ofs,y1+logo_ofs,x3+logo_ofs,y1+6+logo_ofs,color);
    linex (x3+logo_ofs,x4+logo_ofs,y1+6+logo_ofs,color);
    draw (x4+logo_ofs,y1+6+logo_ofs,x1+logo_ofs,y1+logo_ofs,color);
    fill (x1+logo_ofs+2,y1+logo_ofs+1,color);
  END; { t_box2 }



PROCEDURE t_box5 (x1,y1,x2,x3,x4,x5 : WORD; color : BYTE);

  BEGIN { t_box5 }
    linex (x1+logo_ofs,x2+logo_ofs,y1+logo_ofs,color);
    draw (x2+logo_ofs,y1+logo_ofs,x3+logo_ofs,y1+2+logo_ofs,color);
    draw (x3+logo_ofs,y1+2+logo_ofs,x4+logo_ofs,y1+4+logo_ofs,color);
    draw (x4+logo_ofs,y1+4+logo_ofs,x5+logo_ofs,y1+6+logo_ofs,color);
    linex (x5+logo_ofs,x1+logo_ofs,y1+6+logo_ofs,color);
    liney (x1+logo_ofs,y1+logo_ofs,y1+6+logo_ofs,color);
    fill (x1+logo_ofs+1,y1+logo_ofs+1,color);
  END; { t_box5 }



PROCEDURE t_box7 (x1,y1,x2,x3,x4,x5,x6,x7,x8 : WORD;
                  color : BYTE);

  BEGIN { t_box7 }
    linex (x1+logo_ofs,x2+logo_ofs,y1+logo_ofs,color);
    draw (x2+logo_ofs,y1+logo_ofs,x3+logo_ofs,y1+1+logo_ofs,color);
    draw (x3+logo_ofs,y1+1+logo_ofs,x4+logo_ofs,y1+2+logo_ofs,color);
    draw (x4+logo_ofs,y1+2+logo_ofs,x5+logo_ofs,y1+3+logo_ofs,color);
    draw (x5+logo_ofs,y1+3+logo_ofs,x6+logo_ofs,y1+4+logo_ofs,color);
    draw (x6+logo_ofs,y1+4+logo_ofs,x7+logo_ofs,y1+5+logo_ofs,color);
    draw (x7+logo_ofs,y1+5+logo_ofs,x8+logo_ofs,y1+6+logo_ofs,color);
    linex (x8+logo_ofs,x1+logo_ofs,y1+6+logo_ofs,color);
    liney (x1+logo_ofs,y1+logo_ofs,y1+6+logo_ofs,color);
    fill (x1+logo_ofs+1,y1+logo_ofs+1,color);
  END; { t_box7 }



PROCEDURE logo_IBM (color : BYTE);

{ draw big logo with color                                 }

  BEGIN { logo_IBM }

    { Letter I }
    t_box (15,51,62,color);
    t_box (15,64,62,color);
    t_box (27,77,50,color);
    t_box (27,90,50,color);
    t_box (27,103,50,color);
    t_box (27,116,50,color);
    t_box (15,129,62,color);
    t_box (15,142,62,color);

    { Letter B }
    t_box7 (78,51,133,138,141,143,145,147,149,color);
    t_box5 (78,64,157,159,160,161,color);
    t_box (90,77,113,color);     t_box5 (136,77,162,162,161,160,color);
    t_box7 (90,90,155,154,153,152,150,147,143,color);
    t_box7 (90,103,143,147,149,150,152,154,155,color);
    t_box (90,116,113,color);    t_box5 (136,116,160,161,162,162,color);
    t_box5 (78,129,161,160,159,157,color);
    t_box7 (78,142,149,148,147,145,143,138,133,color);

    { Letter M }
    t_box2 (177,51,215,218,177,color);    t_box2 (259,51,297,297,256,color);
    t_box2 (177,64,221,224,177,color);    t_box2 (253,64,297,297,250,color);
    t_box2 (189,77,227,230,189,color);    t_box2 (247,77,285,285,244,color);
    t_box2 (189,90,233,236,189,color);    t_box2 (241,90,285,285,238,color);
    t_box (189,103,212,color);            t_box2 (215,103,259,256,218,color);
    t_box (262,103,285,color);
    t_box (189,116,212,color);            t_box2 (221,116,253,250,224,color);
    t_box (262,116,285,color);
    t_box (177,129,212,color);            t_box2 (227,129,247,244,230,color);
    t_box (262,129,297,color);
    t_box (177,142,212,color);            t_box2 (233,142,241,238,236,color);
    t_box (262,142,297,color);

  END; { logo_IBM }



PROCEDURE shade_logo;

{ shade the 8 bars of the logo with total 56 colors        }

  VAR count1,count2,
      col,offset     : WORD;
      color          : BYTE;

{ Explanation of used variables                            }
{   count1 : counts the bar number (0-7)                   }
{   count2 : counts the screen lines of one bar (0-6)      }
{   col    : x-coordinates of the big logo (15-297)        }
{   offset : memory address of pixel                       }
{   color  : color of each bar-line (1-56)                 }

{ the color in the line is only changed when the pixel has }
{ color 102, each different color isn't of big logo        }

  BEGIN { shade_logo }
    color := 1;
    FOR count1 := 0 TO 7 DO              { 8 bars          }
      FOR count2 := 0 TO 6 DO            { 7 shades / bar  }
        BEGIN
          offset := (count1*13 + count2 + 51)*320;
          FOR col := 15 TO 297 DO        { columns of logo }
            IF MEM [$a000:offset+col] = 102 THEN
               MEM [$a000:offset+col] := color;
          INC (color);
        END;
  END; { shade_logo }



PROCEDURE little_logo (x,y : WORD);

{ draw little logo at position x,y with color 102          }

  BEGIN { little_logo }

    { Letter I }
    linex (0+x,6+x,0+y,102);
    linex (0+x,6+x,2+y,102);
    linex (2+x,4+x,4+y,102);
    linex (2+x,4+x,6+y,102);
    linex (2+x,4+x,8+y,102);
    linex (2+x,4+x,10+y,102);
    linex (0+x,6+x,12+y,102);
    linex (0+x,6+x,14+y,102);

    { Letter B }
    linex (11+x,20+x,0+y,102);
    linex (11+x,22+x,2+y,102);
    linex (13+x,15+x,4+y,102);    linex (20+x,22+x,4+y,102);
    linex (13+x,21+x,6+y,102);
    linex (13+x,21+x,8+y,102);
    linex (13+x,15+x,10+y,102);   linex (20+x,22+x,10+y,102);
    linex (11+x,22+x,12+y,102);
    linex (11+x,20+x,14+y,102);

    { Letter M }
    linex (26+x,31+x,0+y,102);    linex (39+x,44+x,0+y,102);
    linex (26+x,32+x,2+y,102);    linex (38+x,44+x,2+y,102);
    linex (28+x,33+x,4+y,102);    linex (37+x,42+x,4+y,102);
    linex (28+x,34+x,6+y,102);    linex (36+x,42+x,6+y,102);
    linex (28+x,30+x,8+y,102);    linex (32+x,38+x,8+y,102);
    linex (40+x,42+x,8+y,102);
    linex (28+x,30+x,10+y,102);   linex (33+x,37+x,10+y,102);
    linex (40+x,42+x,10+y,102);
    linex (26+x,30+x,12+y,102);   linex (34+x,36+x,12+y,102);
    linex (40+x,44+x,12+y,102);
    linex (26+x,30+x,14+y,102);   plot_w_t (35+x,14+y,102);
    linex (40+x,44+x,14+y,102);

  END; { little_logo }



PROCEDURE shade_little (choice : INTEGER);

  VAR count1,
      col,row,
      offset   : WORD;
      color    : BYTE;

{ Explanation of variables                                 }
{   count1 : horizontal count of the little logos          }
{   col    : columns of little logos (0-44)                }
{   row    : rows of screen (logos are in rows 4-193)      }
{   offset : memory address of pixel                       }
{   color  : actual color to set the pixel (range 57-101)  }

{ color is only changed if it has the value 102, other     }
{ values don't belong to the little logos                  }

  BEGIN { shade_little }
    CASE choice OF

{ colors are scrolled from left to right in all logos      }
    1: BEGIN
        FOR count1 := 0 TO 5 DO
          BEGIN
            color := 57;
            FOR col := 0 TO 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                  END;
                INC (color);
              END;
          END;
       END;

{ colors are scrolled to the center of the screen          }
    2: BEGIN
        FOR count1 := 0 TO 2 DO
          BEGIN
            color := 57;
            FOR col := 0 TO 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                    IF MEM [$a000:offset-col+200] = 102 THEN
                       MEM [$a000:offset-col+200] :=color;
                  END;
                INC (color);
              END;
          END;
       END;

{ colors are scrolled from center to outside               }
    3: BEGIN
        FOR count1 := 0 TO 2 DO
          BEGIN
            color := 101;
            FOR col := 0 TO 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                    IF MEM [$a000:offset-col+200] = 102 THEN
                       MEM [$a000:offset-col+200] :=color;
                  END;
                DEC (color);
              END;
          END;
       END;

{ all little logos are black                               }
    4: BEGIN
        palette [102].red   := 0;
        palette [102].green := 0;
        palette [102].blue  := 0;
       END;

{ all little logos are white                               }
    5: BEGIN
        palette [102].red   := 45;
        palette [102].green := 45;
        palette [102].blue  := 45;
       END;

{ colors are scrolled from left to right in all logos      }
{ shade goes about the whole screen                        }
    6: BEGIN
        color := 57;
        FOR count1 := 0 TO 5 DO
          BEGIN
            col := 0;
            WHILE col <= 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                  END;
                INC (col);
                IF (col DIV 6)*6 = col THEN INC (color);
              END;
          END;
       END;

{ colors are scrolled from outside to center in all logos  }
{ shade goes about the whole screen                        }
    7: BEGIN
        color := 57;
        FOR count1 := 0 TO 2 DO
          BEGIN
            col := 0;
            WHILE col <= 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                    offset := 5*52 + 51 + row*320 - count1*52 -col;
                    IF MEM [$a000:offset] = 102 THEN
                       MEM [$a000:offset] :=color;
                  END;
                INC (col);
                IF (col DIV 3)*3 = col THEN INC (color);
              END;
          END;
       END;

{ colors are scrolled from outside to center in all logos  }
{ shade goes about the whole screen                        }
    8: BEGIN
        color := 101;
        FOR count1 := 0 TO 2 DO
          BEGIN
            col := 0;
            WHILE col <= 44 DO
              BEGIN
                FOR row := 4 TO 193 DO
                  BEGIN
                    offset := count1*52 + 7 + row*320;
                    IF MEM [$a000:offset+col] = 102 THEN
                       MEM [$a000:offset+col] :=color;
                    offset := 5*52 + 51 + row*320 - count1*52 -col;
                    IF MEM [$a000:offset] = 102 THEN
                       MEM [$a000:offset] :=color;
                  END;
                INC (col);
                IF (col DIV 3)*3 = col THEN DEC (color);
              END;
          END;
       END;

    END; { of CASE choice }
  END; { shade_little }



PROCEDURE play_with_palette (r,g,b : INTEGER);

  VAR i,j,max : INTEGER;
      static  : BOOLEAN;  { colors of little logo are
                            static if true }

  BEGIN { play_with_palette }

    static := little in [0,4,5];
    IF (r+g+b=3) AND static THEN max := 127
       ELSE max := 255;

    FOR j := 0 TO max DO
      BEGIN

{ check ESC - key                                          }
        IF KEYPRESSED THEN
          BEGIN
            key := READKEY;
            IF key = CHR (27) THEN
              BEGIN
                restore_old_video_state;
                HALT;
              END;
          END;

{ check for stop time if needed                            }
        IF check_time THEN
           BEGIN
             GETTIME (hour,min,sec,hundred);
             IF hour*3600 + min*60 + sec > endtime THEN
                BEGIN
                  restore_old_video_state;
                  HALT;
                END;
           END;

{ shift palette up one (big logo)                          }
        FOR i:= 56 DOWNTO 2 DO palette[i] := palette[i-1];

{ shift palette up one (little logos)                      }
        FOR i := 101 DOWNTO 58 DO palette[i] := palette[i-1];

        IF j<64 THEN
          BEGIN
            IF (r=1) AND (palette[1].red<63) THEN
                INC (palette[1].red);
            IF (g=1) AND (palette[1].green<63) THEN
                INC (palette[1].green);
            IF (b=1) AND (palette[1].blue<63) THEN
                INC (palette[1].blue);
            IF (r=0) AND (palette[57].red<63) THEN
                INC (palette[57].red);
            IF (g=0) AND (palette[57].green<63) THEN
                INC (palette[57].green);
            IF (b=0) AND (palette[57].blue<63) THEN
                INC (palette[57].blue);
          END
          ELSE IF j < 128 THEN
            BEGIN
              IF (r=1) AND (palette[1].red>0) THEN
                DEC (palette[1].red);
              IF (g=1) AND (palette[1].green>0) THEN
                DEC (palette[1].green);
              IF (b=1) AND (palette[1].blue>24) THEN
                DEC (palette[1].blue);
              IF (r=0) AND (palette[57].red>0) THEN
                 DEC (palette[57].red);
              IF (g=0) AND (palette[57].green>0) THEN
                 DEC (palette[57].green);
              IF (b=0) AND (palette[57].blue>0) THEN
                 DEC (palette[57].blue);
            END
           ELSE IF j<196 THEN
             BEGIN
               IF (r=0) AND (palette[1].red<63) THEN
                 INC (palette[1].red);
               IF (g=0) AND (palette[1].green<63) THEN
                 INC (palette[1].green);
               IF (b=0) AND (palette[1].blue<63) THEN
                 INC (palette[1].blue);
               IF (r=1) AND (palette[57].red<63) THEN
                 INC (palette[57].red);
               IF (g=1) AND (palette[57].green<63) THEN
                 INC (palette[57].green);
               IF (b=1) AND (palette[57].blue<63) THEN
                 INC (palette[57].blue);
             END
            ELSE
              BEGIN
                IF (r=0) AND (palette[1].red>0) THEN
                  DEC (palette[1].red);
                IF (g=0) AND (palette[1].green>0) THEN
                  DEC (palette[1].green);
                IF (b=0) AND (palette[1].blue>24) THEN
                  DEC (palette[1].blue);
                IF (r=1) AND (palette[57].red>0) THEN
                  DEC (palette[57].red);
                IF (g=1) AND (palette[57].green>0) THEN
                  DEC (palette[57].green);
                IF (b=1) AND (palette[57].blue>0) THEN
                  DEC (palette[57].blue);
              END;

{ set the palette                                          }
{ If the palette change has to be slowed down check        }
{ whether only the lower part of the palette has to be     }
{ changed (this case occurs, when the little logos have a  }
{ static color). Otherwise use the fast routine.           }

        IF slowdown THEN
          IF static THEN slow_lower (palette)
             ELSE slow_pal (palette)
          ELSE fast_pal (palette);

{ wait the so many retraces as given by Wn option          }
        DELAY (16*wait);
     END;
  END; { play_with_palette }



PROCEDURE first_text;

BEGIN { first_text }
  CLRSCR;
  TEXTCOLOR (15);
  WRITELN ('                     VGA_IBM_Logo  Version 1.21');
  TEXTCOLOR (7);
  WRITELN;
  WRITELN ('Copyright (c) 1988 IBM Corporation');
  WRITELN;
  WRITELN ('IBM Internal Use Only.');
  WRITELN;
  WRITELN ('by Christian Michel');
  WRITELN ('   IBM Deutschland GmbH, BI Berufsausbildung Sindelfingen');
  WRITELN ('   VM-ID: CMICHEL at STUTVM3');
  WRITELN;
  WRITE   ('This program is a demonstration of the VGA/MCGA ');
  WRITELN ('320 x 200 x 256 colors mode.');
  WRITELN;
END; { first_text }



PROCEDURE help_parameters;

BEGIN { help_parameters }
   first_text;
   WRITELN ('Options:  VGALOGO [Ln] [Wn] [D<n>] [S<n>]');
   WRITE   ('          Ln : changes the way the colors ');
   WRITELN ('of the little logos are scrolled');
   WRITE   ('               (0-suppress little logos, 1-');
   WRITELN ('left to right, 2-to center,');
   WRITE   ('                3-to outside, 4-static ');
   WRITELN ('black, 5-static white,');
   WRITE   ('                6..8-same as 1..3 but about ');
   WRITELN ('the whole screen)');
   WRITE   ('          Wn : selects the speed the colors ');
   WRITELN ('are changed (Wait cycles)');
   WRITELN ('               (0 <= n <= 10) ');
   WRITELN ('          D  : skips title screen (Direct start)');
   WRITELN ('          Dn : runs demo for n seconds (Duration)');
   WRITE   ('          S  : Slowdown palette shift to suppress ');
   WRITELN ('snow on slow computers');
   WRITE   ('          Sn : Slowdown mode of palette shift ');
   WRITELN ('(0-don''t slowdown, 1-slowdown)');
   WRITE   ('Default: L1, W0, demo runs until ESC pressed, ');
   WRITE   ('fast palette shift on 80286 models');
   REPEAT UNTIL KEYPRESSED;
   restore_old_video_state;
   HALT;
END; { help_parameters }



BEGIN { main_program }

{ check presence of required graphics adapter              }
  check_vga;

{ restore old video state and switch to text mode          }
  save_old_video_state;

{ check help option                                        }
  IF PARAMCOUNT <> 0 THEN
     IF COPY (PARAMSTR (1),1,1) = '?' THEN help_parameters;

{ set default for variables                                }
  wait := 0; little := 1; endtime := MAXLONGINT;
  directstart := FALSE; check_time := FALSE;

  GETTIME (hour,min,sec,hundred);
  starttime := hour*3600 + min*60 + sec;

{ set the slowdown flag dependent on the computer-model    }
  IF MEM [$f000:$fffe] = $fc THEN slowdown := FALSE
    ELSE slowdown := TRUE;
{ $fc stands for: PC/AT, PC/XT 286, PS/2 Model 50,60,70,80 }

{ parse the commandline options                            }
  IF PARAMCOUNT <> 0 THEN
    FOR i:= 1 TO PARAMCOUNT DO
      BEGIN
        CmdLine := PARAMSTR (i);
        CASE UPCASE (CmdLine[1]) of
          'L': BEGIN
                 DELETE (CmdLine,1,1);
                 VAL (CmdLine,j,error);
                 IF error = 0 THEN little := j;
               END;
          'W': BEGIN
                 DELETE (CmdLine,1,1);
                 VAL (CmdLine,j,error);
                 IF error = 0 THEN wait := j;
               END;
          'S': BEGIN
                 DELETE (CmdLine,1,1);
                 VAL (CmdLine,j,error);
                 IF (error = 0) AND (j = 0) THEN
                     slowdown := FALSE
                   ELSE slowdown := TRUE;
               END;
          'D': BEGIN
                 DELETE (CmdLine,1,1);
                 VAL (CmdLine,j,error);
                 directstart := TRUE;
                 { don't show the title screen }
                 IF error = 0 THEN
                    BEGIN
                      endtime := starttime + j + 2;
                      { building up the screen takes about
                      2 seconds }
                      check_time := TRUE;
                    END;
               END;
          END; { of case }
      END; { of for }

{ check for parameter ranges                               }

  IF NOT (little IN [0..8]) THEN little := 1;
  IF wait > 10 THEN wait := 0;

  logo_ofs := 0;

  IF directstart = FALSE THEN
    BEGIN
      first_text;
      WRITE   ('The program was adapted to VGA/MCGA ');
      WRITELN ('from the 8514/A-program IBMLOGO written by');
      WRITELN ('                             David A Kerr.');
      WRITELN;
      WRITE   ('The routine to change the palette was ');
      WRITELN ('delivered from');
      WRITELN ('        Daniel Butterfield (DAZZLE).');
      WRITELN;
      WRITELN ('Press any key to start the program.');
      WRITELN ('ESC stops execution.');
      REPEAT UNTIL KEYPRESSED;
      key := READKEY;
    END;

  set_mode_13;
  clear_palette;

  logo_IBM (102);
  shade_logo;

{ give 3-D effect to big logo                              }
  FOR draw_color := 103 TO 106 DO
    BEGIN
      INC (logo_ofs);
      logo_IBM (draw_color);
    END;

{ draw little logos only if they're needed                 }
  IF little <> 0 THEN
    BEGIN
      FOR i := 0 TO 7 DO
        FOR j:= 0 TO 5 DO
          little_logo (j*52+7,i*25+4);
      shade_little (little);
    END;

  init_palette;

  REPEAT
    play_with_palette (1,1,1);
    play_with_palette (1,0,0);
    play_with_palette (0,1,0);
    play_with_palette (0,0,1);
  UNTIL FALSE;

END. { main_program }